(*
 *
 *  This file is part of Aws-OCaml
 *
 *  Aws-OCaml is free software: you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation, either version 3 of the License, or
 *  (at your option) any later 
 *  
 *  Aws-OCaml is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *  
 *  You should have received a copy of the GNU General Public License
 *  along with Aws-OCaml. If not, see <http://www.gnu.org/licenses/>.
 *
 *  cache.ml william le ferrand (william@themipsfactory.com) 26/03/2010 09:26
 *
 *)

open Misc

exception Error 

type 'a lease = { value: 'a; mutable ttl : int}

type 'a t = 
    {
      fetch: string -> 'a option ; 
      insert: string -> 'a -> unit ;
      delete: string -> unit ;
    }
    
module CacheMap = Map.Make (String)

let create () =
  let ttl = 600 in
  let tick = ttl / 5 in 

  def cache (m) & fetch (key) = 
      let eo = (try 
		  let e = CacheMap.find key m in
		    e.ttl <- ttl ; 
		    Some e.value
		with Not_found -> None) in
      cache (m) & reply (eo) to fetch 

  or  cache (m) & insert (key, value) = 
      cache (CacheMap.add key { value = value; ttl = ttl } m) & reply to insert

  or  cache (m) & collect () = 
      let nm = CacheMap.fold 
	(fun key lease acc -> 
	   if lease.ttl < 0 then 
	     acc
	   else 
	     (lease.ttl <- lease.ttl - tick; CacheMap.add key lease acc)) m CacheMap.empty in
	cache (nm) & reply to collect 

   or   cache (m) & delete (key) = 
        cache (CacheMap.remove key m) & reply to delete in

  spawn cache (CacheMap.empty);
  spawn (while true do Unix.sleep tick ; collect () done ; 0) ;
    
   { fetch = fetch ; 
     insert = (fun key value -> insert (key, value)) ; 
     delete = delete }


let fetch t = t.fetch 

let insert t = t.insert

let delete t = t.delete 
